home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 65.zip / BS1 part 65 / High Speed Pascal v1.0 d1.adf / HSPascal / AmigaDemos / SpeakersCorner.pas < prev    next >
Pascal/Delphi Source File  |  1992-01-16  |  17KB  |  490 lines
  1. {--------------------------------------------------------------------------
  2.  
  3.                      HighSpeed Pascal for the Amiga
  4.  
  5.                           SPEAKER'S CORNER DEMO
  6.  
  7.                   Programmed by Martin Eskildsen 1991
  8.  
  9.                   Copyright (c) 1991 by D-House I ApS
  10.                          All rights reserved
  11.  
  12.  
  13.   Version : Date (dd.mm.yy) : Comment
  14.   -----------------------------------
  15.     1.00 : 06.11.91 : First version
  16.  
  17. --------------------------------------------------------------------------}
  18.  
  19. program SpeakersCorner;
  20.  
  21. uses Exec, Graphics, Intuition, Narrator, Speech, MenuUtil, Init;
  22.  
  23. const
  24.   version          = '1.00';    { Program's version }
  25.  
  26.   Rev              = 0;        { Library revision required }
  27.  
  28.   MaxInputLen      = 254;    { Number of characters in input buffer }
  29.  
  30.   InitMsg          = 'Speaker''s Corner';  { What to say at boot }
  31.  
  32.   InputSurroundBox : array [1..10] of integer = 
  33.                      (0,0, 325,0, 325,13, 0,13, 0,1);
  34.               { Box surrounding the input string }
  35.  
  36.   SpeakSurroundBox : array [1..10] of integer =
  37.                      (0,0, 195,0, 195,11, 0,11, 0,1);
  38.               { Box surrounding the "I want to speak!" gadget }
  39.  
  40.  
  41. type
  42.   InputStr    = string[MaxInputLen];    { The input buffer }
  43.  
  44. var
  45.   window      : pWindow;    { The program's window }
  46.   menu        : pMenu;        { The main menu }
  47.   input       : InputStr;    { The input buffer }
  48.   Undo        : InputStr;    { Undo buffer for input string }
  49.  
  50.   Font          : tTextAttr;    { The font used for all text }
  51.  
  52.   InputBorder   : tBorder;    { Setup for border around input box }
  53.   InputStrRec   : tStringInfo;    { Setup for the editable string field }
  54.   InputTextRec  : tIntuiText;    { Setup for the text connected to string field }
  55.   InputGadget   : tGadget;    { Assembly of the above }
  56.  
  57.   SpeakBorder   : tBorder;    { Border around "I want to speak!" gadget }
  58.   SpeakTextRec  : tIntuiText;    { "I want to speak!" }
  59.   SpeakGadget   : tGadget;    { Assembly of the above }
  60.  
  61.   PropTexts     : array [0..3] of tIntuiText;
  62.   PropImages    : array [0..3] of tImage;
  63.   PropInfo      : array [0..3] of tPropInfo;
  64.   PropGadgets   : array [0..3] of tGadget;
  65.  
  66.   AboutReq      : array [1..12] of tIntuiText;  { Texts for "About" requester }
  67.   AboutReqOk    : tIntuiText;                   { "Ok" in "About" requester }
  68.  
  69. { Set up all gadgets for main window }
  70. function CreateGadgets : pointer;
  71. var i : 0..3;
  72.  
  73.   { This func adjusts the input value n belonging to [min..max] to fit }
  74.   { the [0..65535] range for the proportional gadgets }
  75.   function MakeValue(n, min, max : System.Word) : System.Word;
  76.   begin
  77.     MakeValue := Trunc(65535 / (max-min) * n)
  78.   end;
  79.  
  80. begin
  81.   Undo := #0;
  82.  
  83. {--- Font information ---}
  84.   with Font do begin
  85.     ta_Name  := CstrConstPtr('topaz.font');
  86.     ta_Ysize := TOPAZ_EIGHTY;
  87.     ta_Style := 0;
  88.     ta_Flags := 0
  89.   end;
  90.  
  91. {--- Input string gadget setup ---}
  92.   with InputBorder do begin
  93.     LeftEdge   := -3;           { Position relative to gadget box }
  94.     TopEdge    := -3;
  95.     FrontPen   := 1;
  96.     BackPen    := 0;
  97.     DrawMode   := JAM1;
  98.     Count      := SizeOf(InputSurroundBox) div SizeOf(Integer) div 2;
  99.     XY         := @InputSurroundBox;
  100.     NextBorder := NIL
  101.   end;
  102.  
  103.   Input := InitMsg + #0;        { Put the intro message in the string gadget }
  104.  
  105.   with InputStrRec do begin
  106.     Buffer     := @Input[1];
  107.     UndoBuffer := @Undo[1];
  108.     BufferPos  := 0;
  109.     MaxChars   := MaxInputLen + 1;      { + 1 to hold #0 }
  110.     DispPos    := 0;
  111.     UndoPos    := 0;                    { The below are maintained by }
  112.     NumChars   := Length(Input);        { Intuition }
  113.     DispCount  := 0;
  114.     Cleft      := 0;
  115.     Ctop       := 0;
  116.     LayerPtr   := NIL;
  117.     LongInt_   := 0;
  118.     AltKeyMap  := NIL
  119.   end;
  120.  
  121.   with InputTextRec do begin
  122.     FrontPen  := 1;
  123.     BackPen   := 0;
  124.     DrawMode  := JAM1;
  125.     LeftEdge  := 0;              { Position relative to string gadget box }
  126.     TopEdge   := -8-3-2;
  127.     ITextFont := @Font;          { The font to use }
  128.     IText     := CstrConstPtr('Input String');
  129.     NextText  := NIL
  130.   end;
  131.  
  132.   with InputGadget do begin
  133.     NextGadget    := NIL;               { This gadget will be last in chain }
  134.     LeftEdge      := 8 + 3;
  135.     TopEdge       := 120;
  136.     Width         := 320;
  137.     Height        := 10;
  138.     Flags         := GADGHCOMP;
  139.     Activation    := RELVERIFY;
  140.     GadgetType    := STRGADGET;
  141.     GadgetRender  := @InputBorder;
  142.     SelectRender  := NIL;
  143.     GadgetText    := @InputTextRec;
  144.     MutualExclude := 0;
  145.     SpecialInfo   := @InputStrRec;
  146.     GadgetID      := 0;
  147.     UserData      := NIL
  148.   end;
  149.  
  150. {--- Speak gadget ---}
  151.   with SpeakBorder do begin
  152.     LeftEdge   := -1;
  153.     TopEdge    := -1;
  154.     FrontPen   := 1;
  155.     BackPen    := 0;
  156.     DrawMode   := JAM1;
  157.     Count      := SizeOf(SpeakSurroundBox) div SizeOf(Integer) div 2;
  158.     XY         := @SpeakSurroundBox;
  159.     NextBorder := NIL
  160.   end;
  161.  
  162.   with SpeakTextRec do begin
  163.     FrontPen  := 1;
  164.     BackPen   := 0;
  165.     DrawMode  := JAM1;
  166.     LeftEdge  := 1;
  167.     TopEdge   := 1;
  168.     ITextFont := @Font;
  169.     IText     := CstrConstPtr('I want to say something!');
  170.     NextText  := NIL
  171.   end;
  172.  
  173.   with SpeakGadget do begin
  174.     NextGadget    := @InputGadget;
  175.     LeftEdge      := 10;
  176.     TopEdge       := 150;
  177.     Width         := 192 + 1 + 1;
  178.     Height        := 8 + 1 + 1;
  179.     Flags         := GADGHCOMP;
  180.     Activation    := RELVERIFY or GADGIMMEDIATE;
  181.     GadgetType    := BOOLGADGET;
  182.     GadgetRender  := @SpeakBorder;
  183.     SelectRender  := NIL;
  184.     GadgetText    := @SpeakTextRec;
  185.     MutualExclude := 0;
  186.     SpecialInfo   := NIL;
  187.     GadgetID      := 0;
  188.     UserData      := NIL
  189.   end;
  190.  
  191. {--- Proportional Gadgets---}
  192.   with PropInfo[0] do begin
  193.     Flags      := AUTOKNOB or FREEHORIZ;
  194.     HorizPot   := 0;
  195.     VertPot    := 0;
  196.     HorizBody  := $1FFF;
  197.     VertBody   := $1FFF;
  198.     CWidth     := 0;                { Intuition property }
  199.     CHeight    := 0;
  200.     HPotRes    := 0;
  201.     VPotRes    := 0;
  202.     LeftBorder := 0;
  203.     TopBorder  := 0
  204.   end;
  205.  
  206.   with PropTexts[0] do begin
  207.     FrontPen  := 1;
  208.     BackPen   := 0;
  209.     DrawMode  := JAM1;
  210.     LeftEdge  := 0;
  211.     TopEdge   := -8-2;
  212.     ITextFont := @Font;
  213.     IText     := NIL;
  214.     NextText  := NIL
  215.   end;
  216.   
  217.   with PropImages[0] do begin           { Should NOT be initialized }
  218.   end;                                  { Intuition uses it }
  219.  
  220.   with PropGadgets[0] do begin
  221.     NextGadget    := @SpeakGadget;
  222.     LeftEdge      := 7;
  223.     TopEdge       := 23;
  224.     Width         := 327;
  225.     Height        := 10;
  226.     Flags         := GADGHCOMP or GADGIMAGE;
  227.     Activation    := RELVERIFY or GADGIMMEDIATE;
  228.     GadgetType    := PROPGADGET;
  229.     GadgetRender  := NIL;
  230.     SelectRender  := NIL;
  231.     GadgetText    := NIL;
  232.     MutualExclude := 0;
  233.     SpecialInfo   := NIL;
  234.     GadgetID      := 0;
  235.     UserData      := NIL
  236.   end;
  237.  
  238.   for i := 0 to 3 do begin
  239.     PropGadgets[i] := PropGadgets[0];
  240.     PropImages [i] := PropImages [0];
  241.     PropTexts  [i] := PropTexts  [0];
  242.     PropInfo   [i] := PropInfo   [0];
  243.     with PropGadgets[i] do begin
  244.       if i > 0 then NextGadget := @PropGadgets[i-1];
  245.       TopEdge       := PropGadgets[0].TopEdge + i*22;
  246.       GadgetRender := @PropImages[i];
  247.       GadgetText   := @PropTexts [i];
  248.       SpecialInfo  := @PropInfo  [i]
  249.     end;
  250.     case i of
  251.       0 : begin
  252.             PropTexts[0].IText := CstrConstPtr('Sample Frequency');
  253.             PropInfo[0].HorizPot := MakeValue(DEFFREQ, MINFREQ, MAXFREQ)
  254.           end;
  255.       1 : begin
  256.             PropTexts[1].IText := CstrConstPtr('Rate');
  257.             PropInfo[1].HorizPot := MakeValue(DEFRATE, MINRATE, MAXRATE)
  258.           end;
  259.       2 : begin
  260.             PropTexts[2].IText := CstrConstPtr('Pitch');
  261.             PropInfo[2].HorizPot := MakeValue(DEFPITCH, MINPITCH, MAXPITCH)
  262.           end;
  263.       3 : begin
  264.             PropTexts[3].IText := CstrConstPtr('Volume');
  265.             PropInfo[3].HorizPot := MakeValue(DEFVOL, MINVOL, MAXVOL)
  266.           end
  267.     end;  { case }
  268.   end;
  269.  
  270.   CreateGadgets := @PropGadgets[3]
  271. end;
  272.  
  273. { Create a character-centred string. width is field width in characters }
  274. function Center(s : string; width : byte) : string;
  275. var i : byte;
  276. begin
  277.   for i := 1 to (width - length(s)) div 2 do s := ' ' + s;
  278.   Center := s
  279. end;
  280.  
  281. procedure SetUp;
  282. var
  283.   def : tNewWindow;     { Definition of window }
  284.   m   : pMenu;          { Temporary used when constructing menu }
  285.   i   : byte;
  286. begin
  287.  
  288.   { Open the used libraries }
  289.  
  290.   IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library', Rev));
  291.   GfxBase       := pGfxBase      (OpenLibrary('graphics.library',  Rev));
  292.  
  293.   { First, define what the window should look like }
  294.  
  295.   with def do begin
  296.     LeftEdge      := 0;
  297.     TopEdge       := 0;
  298.     Width         := 340;
  299.     Height        := 170;
  300.     DetailPen     := -1;
  301.     BlockPen      := -1;
  302.     Title         := CStrConstPtr('Speaker''s Corner version ' + version);
  303.     Flags         := WINDOWCLOSE   or     { Add Close gadget, }
  304.                      WINDOWDEPTH   or     { depth arrangement gadgets }
  305.                      WINDOWDRAG    or     { and make it movable }
  306.                      SMART_REFRESH or     { Save window in RAM }
  307.                      ACTIVATE      or     { Activate it }
  308.                      NOCAREREFRESH;       { Don't wanna hear of refreshes! }
  309.     IDCMPFlags    := CLOSEWINDOW_  or     { But of user-clicks on Close }
  310.                      MENUPICK      or     { ...menu selections and }
  311.                      GADGETUP;            { ...released gadgets }
  312.     Type_         := WBENCHSCREEN;        { Put window on workbench screen }
  313.     FirstGadget   := CreateGadgets;       { The gadgets attached }
  314.     CheckMark     := NIL;                 { Same checkmark as usual }
  315.     Screen        := NIL;                 { Use workbench screen }
  316.     BitMap        := NIL;                 { No bitmap }
  317.     MinWidth      := Width;               { Dummies as we can't resize }
  318.     MinHeight     := Height;              { this window }
  319.     MaxWidth      := MinWidth;
  320.     MaxHeight     := MinHeight
  321.   end;
  322.  
  323.   { Then, construct the menus }
  324.  
  325.   InitMenu(menu, ' Info ');
  326.   AddItem (menu, ' About Speaker''s Corner... ', ITEMENABLED or HIGHCOMP, 0, #0);
  327.   AddItem (menu, '---------------------------', 0, 0, #0);
  328.   AddItem (menu, ' Exit',                        ITEMENABLED or HIGHCOMP or COMMSEQ, 0, 'E');
  329.  
  330.   AddMenu (m, menu, ' Sex ');
  331.   AddItem (m, '   Male       ', ITEMENABLED or HIGHCOMP or COMMSEQ or CHECKIT or CHECKED, $FFFE, 'M');
  332.   AddItem (m, '   Female     ', ITEMENABLED or HIGHCOMP or COMMSEQ or CHECKIT,            $FFFD, 'F');
  333.  
  334.   AddMenu (m, menu, ' Mode ');
  335.   AddItem (m, '   Human      ', ITEMENABLED or HIGHCOMP or COMMSEQ or CHECKIT or CHECKED, $FFFE, 'H');
  336.   AddItem (m, '   Robot      ', ITEMENABLED or HIGHCOMP or COMMSEQ or CHECKIT,            $FFFD, 'R');
  337.  
  338.   { Open the window }
  339.  
  340.   window := OpenWindow(@def);
  341.   if window = NIL then begin
  342.     writeln('Can''t open window');
  343.     halt(0)
  344.   end;
  345.  
  346.   if SetMenuStrip(window, menu) and OpenSpeech then { nothing } ;
  347.  
  348. {--- "About..." requester ---}
  349.   for i := 1 to 12 do                   { Create 12 lines }
  350.     with AboutReq[i] do begin
  351.       FrontPen  := 0;
  352.       BackPen   := 1;
  353.       DrawMode  := JAM1;
  354.       LeftEdge  := 6;
  355.       TopEdge   := i*10;
  356.       ITextFont := @Font;
  357.       if i < 12 then NextText  := @AboutReq[i+1] else NextText := NIL
  358.     end;
  359.  
  360.   { Then insert the text into all 12 lines }
  361.   AboutReq[ 1].IText := CstrConstPtr(Center('Speaker''s Corner version '+version, 36));
  362.   AboutReq[ 2].IText := CstrConstPtr(Center('', 36));
  363.   AboutReq[ 3].IText := CstrConstPtr(Center('a', 36));
  364.   AboutReq[ 4].IText := CstrConstPtr(Center('HighSpeed Pascal', 36));
  365.   AboutReq[ 5].IText := CstrConstPtr(Center('Demo Program', 36));
  366.   AboutReq[ 6].IText := CstrConstPtr(Center('', 36));
  367.   AboutReq[ 7].IText := CstrConstPtr(Center('Programming by', 36));
  368.   AboutReq[ 8].IText := CstrConstPtr(Center('Martin Eskildsen/D-House I', 36));
  369.   AboutReq[ 9].IText := CstrConstPtr(Center('', 36));
  370.   AboutReq[10].IText := CstrConstPtr(Center('You can contact HiSoft on', 36));
  371.   AboutReq[11].IText := CstrConstPtr(Center('Tel +44 525 718181', 36));
  372.   AboutReq[12].IText := CstrConstPtr(Center('Fax +44 525 713716', 36));
  373.  
  374.   with AboutReqOk do begin
  375.     FrontPen  := 0;
  376.     BackPen   := 1;
  377.     DrawMode  := JAM1;
  378.     LeftEdge  := 6;                     { Position relative to gadget }
  379.     TopEdge   := 3;
  380.     ITextFont := @Font;
  381.     IText     := CstrConstPtr('Ok');
  382.     NextText  := NIL
  383.   end;
  384.  
  385.   Say(InitMsg)                          { Say hi to the user }
  386.  
  387. end;
  388.  
  389. procedure GoodBye;
  390. begin
  391.   CloseSpeech;
  392.   ClearMenuStrip(window);
  393.   CloseWindow(window);
  394.   CloseLibrary(pLibrary(IntuitionBase));  { Close Intuition }
  395.   CloseLibrary(pLibrary(GfxBase))         { and Graphics }
  396. end;
  397.  
  398. procedure MakeInputPascal;
  399. begin
  400.   input[0] := #255;                     { Assume input = 255 chars for Pos }
  401.   input[0] := Chr(Pos(#0, input) - 1)   { But use only up to #0 }
  402. end;
  403.  
  404. procedure About;
  405. var bool : boolean;
  406. begin
  407.   bool := AutoRequest(window, @AboutReq[1], NIL, @AboutReqOk, 0, 0, 320, 155)
  408. end;
  409.  
  410. function MakeValue(n, low, high : System.Word) : System.Word;
  411. begin
  412.   MakeValue := Trunc( n / (65535 / (high - low)) )
  413. end;
  414.  
  415. procedure SelectLoop;
  416. var
  417.   dummy    : integer;
  418.   Imessage : pIntuiMessage;   { The messages sent to this program }
  419.   class    : integer;         { Message class }
  420.   code     : integer;         { Message code }
  421.   quit     : boolean;         { TRUE = done showing menu }
  422.   mNum     : integer;         { Menu number selected }
  423.   iNum     : integer;         { Item number selected }
  424.   address  : pointer;         { Objects' address }
  425.   ItemPtr  : pMenuItem;       { Pointer to a menu item structure }
  426.   TextPtr  : pIntuiText;      { Pointer to a IntuiText structure }
  427. begin
  428.   quit := FALSE;                           { Not done yet }
  429.   repeat
  430.     dummy := Wait(BitMask(window^.UserPort^.MP_SIGBIT));
  431.                                         { Wait for something to happen }
  432.  
  433.     Imessage := pIntuiMessage(GetMsg(window^.UserPort));
  434.                                         { Find out what }
  435.     while Imessage <> NIL do begin
  436.       class   := Imessage^.class;       { Save for later use }
  437.       code    := Imessage^.code;
  438.       address := Imessage^.IAddress;
  439.       ReplyMsg(pMessage(Imessage));     { Accept this message }
  440.       case class of
  441.         MENUPICK     : { The right mouse key was pressed }
  442.                        if code <> MENUNULL then begin  { Pointed at menu? }
  443.                          mNum := MenuNum(code);        { Title index }
  444.                          iNum := ItemNum(code);        { Item index }
  445.                          case mNum of
  446.                            0 : case iNum of            { Info menu }
  447.                                  0 : About;
  448.                                  2 : quit := TRUE
  449.                                end;
  450.                            1 : case iNum of            { Sex menu }
  451.                                  0 : SetSex(male);
  452.                                  1 : SetSex(female)
  453.                                end;
  454.                            2 : case iNum of            { Mode menu }
  455.                                  0 : SetMode(human);
  456.                                  1 : SetMode(robot)
  457.                                end
  458.                          end;
  459.                          if not ( (mNum = 0) and (iNum = 0) ) then begin
  460.                            ItemPtr := pMenuItem(ItemAddress(menu, code));
  461.                            TextPtr := pIntuiText(ItemPtr^.ItemFill);
  462.                            Say(RetrieveStr(TextPtr^.IText))
  463.                          end
  464.                        end;
  465.         GADGETUP     : if (address = @SpeakGadget) or (address = @InputGadget) then begin
  466.                          MakeInputPascal;
  467.                          Say(input)
  468.                        end else
  469.                        if address = @PropGadgets[0] then
  470.                          SetFrequency(MakeValue(PropInfo[0].HorizPot, MINFREQ, MAXFREQ)) else
  471.                        if address = @PropGadgets[1] then
  472.                          SetRate     (MakeValue(PropInfo[1].HorizPot, MINRATE, MAXRATE)) else
  473.                   if address = @PropGadgets[2] then
  474.                          SetPitch    (MakeValue(PropInfo[2].HorizPot, MINPITCH, MAXPITCH)) else
  475.                if address = @PropGadgets[3] then
  476.                          SetVolume   (MakeValue(PropInfo[3].HorizPot, MINVOL,  MAXVOL ))
  477.                        else writeln('Bad gadget! addr=',longint(address),' (dec.)');
  478.         CLOSEWINDOW_ : quit := TRUE
  479.       end;
  480.       Imessage := pIntuiMessage(GetMsg(window^.UserPort)) { Get next }
  481.     end;
  482.   until quit
  483. end;
  484.  
  485. begin
  486.   SetUp;
  487.   SelectLoop;
  488.   GoodBye
  489. end.
  490.